HPAVC/HPAVC CD-ROM.iso/PRUS101.ZIP/FTIMER.PAS

Pascal/Delphi Source File | 1994-12-19 | 10KB | 373 lines

UNIT FTIMER; { FIDO unit for handling 10 timers}
 (***************************************************************************

            RELEASE 1.02 - as contained in the file PRUS101.LZH
                by Peter Holschbach, 2:2450/660.3, GERMANY

               --------------------------------------------
                organized for Fido's PASCAL related echoes
               --------------------------------------------

     06/28/1994 to --/--/---- by Peter Holschbach, 2:2450/660.3, GERMANY


           As far as third party copyrights are not violated this
           source code is hereby placed to the public domain. Use
           it whatever way you want, but use AT YOUR OWN RISK.

           In case you should modify the source rather send your
           modifications to the unit's current organizer (see above for
           NM address) than to spread it on your own. This will help to
           keep the unit updated and grant a certain standard to all
           other users as well.

           The unit is currently still under work. So it might greatly
           benefit of your participation.

           Those who contributed to the following piece of source,
           listed in alphabethical order:
        ================================================================
           Peter Holschbach ...
        ================================================================
           YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.

           Credits in your own programs are as welcome as unnecessary.

 ***************************************************************************)

{$I FDEFINE.DEF}

{.$DEFINE UseBios}

Interface

Const TicksPerSecond     = 18.20650864;
      FastTicksPerSecond = 4.772727E6/4;

Var TimerHandle : Word;

{----------------------------------------------------------------------------}

Procedure DeInstallFastTimer;
Function  GetFastTimerHandle : Word;
Function  GetTimerHandle : Word;
Function  GetFastTimeSec (Handle:Word) : Real;
Function  GetTimeSec (Handle:Word) : LongInt;
Function  GetTimeTicks (Handle:Word) : LongInt;
Procedure InstallFastTimer;
Function  ReadFastTimer : LongInt;
Procedure StartFastTimer (Handle :Word);
Procedure StartTimer (Handle :Word);
Procedure StopTimer (Handle :Word);
Function  UnGetFastTimerHandle (Handle :Word): Boolean;
Function  UnGetTimerHandle (Handle :Word): Boolean;

{----------------------------------------------------------------------------}

Implementation


Uses FChkOs;

Const
         TicksPerDay    = $1800B2;

         WindowsEnhanced : Boolean = FALSE;
Type
      TimeAccessRec = Record
          Case Word of
            1 : (LSW,MSW:Word);
            0 : (LWord : LongInt);
          End;

Const  MaxTimerHandle = 10;
       MaxLongx2 = 4294967296.0; (* max. positive number of longint * 2 *)
       FastTimeSecOffset : Real = 0.0; (* Runtime of StartFastTimer and
                                          GetFastTimeSec                *)

       FreeHandles    : Array [1..MaxTimerHandle] of Boolean =
             (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE);

       FreeFastHandles    : Array [1..MaxTimerHandle] of Boolean =
             (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE);


Var
     StartTimeField : Array [1..MaxTimerHandle] of LongInt;
     StartFastTimeField : Array [1..MaxTimerHandle] of LongInt;

{----------------------------------------------------------------------------}
Procedure DeInstallFastTimer;

Begin
  ASM
    MOV AL,$36
    OUT $43,AL
    MOV AL,00
    OUT $40,AL
    OUT $40,AL
  End;
End;

{----------------------------------------------------------------------------}

Procedure StartFastTimer (Handle : Word);


Begin
  StartFastTimeField [Handle] := ReadFastTimer;
End;

{----------------------------------------------------------------------------}
Procedure StartTimer (Handle : Word);
{ Original author: Peter Holschbach }

Var Time : TimeAccessRec;


Begin
  TimerHandle := Handle;
  If Handle = 0 then Begin
    Handle := GetTimerHandle;
    If Handle <> 0 then TimerHandle := Handle
    Else Exit;
  End;
{$IFDEF UseBios}
  ASM
    MOV AX,00           (* SubFunction GetTime *)
    INT $1A             (* Bios-Funktion *)
    MOV Time.LSW,DX
    MOV Time.MSW,CX
  End;
{$ELSE}
  ASM
    MOV  AX,$40
    PUSH AX
    POP  ES
    CLI
    MOV DX,ES:[$6C]
    MOV CX,ES:[$6E]
    STI
    MOV Time.LSW,DX
    MOV Time.MSW,CX
  End;
{$ENDIF}
  StartTimeField [Handle] := Time.LWord;
End;

{----------------------------------------------------------------------------}

Procedure StopTimer (Handle :Word);
{ Original author: Peter Holschbach }

Begin
  StartTimeField [Handle] := $FFFF;
End;

{----------------------------------------------------------------------------}

Function GetTimeTicks (Handle : Word): LongInt;
{ Original author: Peter Holschbach }

Var Time  : TimeAccessRec;
    Ticks : LongInt;

Begin
{$IFDEF UseBios}
   ASM
    MOV AH,00           (* SubFunction GetTime *)
    INT $1A             (* Bios-Funktion *)
                        (* CX,DX = 32Bit Counter *)
    MOV Time.LSW,DX
    MOV Time.MSW,CX
  End;
{$ELSE}
  ASM
    MOV  AX,$40
    PUSH AX
    POP  ES
    CLI
    MOV DX,ES:[$6C]
    MOV CX,ES:[$6E]
    STI
    MOV Time.LSW,DX
    MOV Time.MSW,CX
  End;
{$ENDIF}
  If (Time.LWord < StartTimeField [Handle]) then Begin
     Ticks := TicksPerDay - StartTimeField [Handle] + Time.LWord;
  End
  Else Begin
    Ticks := Time.LWord - StartTimeField [Handle];
  End;
  GetTimeTicks := Ticks;
End;

{----------------------------------------------------------------------------}

Function  GetFastTimeSec (Handle:Word) : Real;

Var TmpValue : LongInt;
    StartReal,
    StopReal : Real;

Begin
  TmpValue := ReadFastTimer;

  (* longint is to short for calculate the time, so we must use real *)
  If StartFastTimeField [Handle] < 0 then  (* we need a unsigned number *)
    StartReal := MaxLongx2 + StartFastTimeField [Handle]
  Else
    StartReal := StartFastTimeField [Handle];

  If TmpValue < 0 then
    StopReal  := MaxLongx2 + TmpValue
  Else
    StopReal  := TmpValue;

  GetFastTimeSec := (StopReal - StartReal - FastTimeSecOffset) / FastTicksPerSecond;
End;

{----------------------------------------------------------------------------}
Function GetTimeSec (Handle:Word) : LongInt;
{ Original author: Peter Holschbach }

Begin
  GetTimeSec := GetTimeTicks (Handle) * 10 div 182;
End;

{----------------------------------------------------------------------------}
Function  GetFastTimerHandle : Word;
{ Original author: Peter Holschbach }
Var L :  Word;

Begin
  L := 0;
  Repeat
    Inc (L)
  Until (L > MaxTimerHandle) Or Not FreeFastHandles [L];
  If L > MaxTimerHandle Then GetFastTimerHandle := 0
  else Begin
    FreeFastHandles [L] := True;
    GetFastTimerHandle := L;
  End;
End;


{----------------------------------------------------------------------------}
Function  GetTimerHandle : Word;
{ Original author: Peter Holschbach }
Var L :  Word;

Begin
  L := 0;
  Repeat
    Inc (L)
  Until (L > MaxTimerHandle) Or Not FreeHandles [L];
  If L > MaxTimerHandle Then GetTimerHandle := 0
  else Begin
    FreeHandles [L] := True;
    GetTimerHandle := L;
  End;
End;

{----------------------------------------------------------------------------}
Procedure InstallFastTimer;

  Function GetFastTimer : LongInt;

  Begin
    GetFastTimer := ReadFastTimer;
  End;


Var a,b : LongInt;
    ar,br : Real;
    tmpReal : Real;
    L       : Word;

Begin
  ASM
    MOV AL,$34   (* we use timer 0 in mode 2 *)
    OUT $43,AL
    MOV AL,00
    OUT $40,AL
    OUT $40,AL
  End;
  TmpReal := 0;
  For L:= 1 to 10 do Begin
    FastTimeSecOffset := 00;
    a:=  GetFastTimer;
    b := GetFastTimer;
    if a < 0 then ar := MaxLongx2 + a
    else ar := a;

    if b < 0 then br := MaxLongx2 + b
    else br := b;
    tmpReal := TmpReal + br - ar;
    If L <> 1 then tmpReal := TmpReal / 2;
  End;
  FastTimeSecOffset := TmpReal;
End;

{----------------------------------------------------------------------------}
Function ReadFastTimer : LongInt;

Var TmpValue : TimeAccessRec;

Begin
  ASM
      MOV   AX,$40      (* BIOS-RAM Segment Adress *)
      MOV   ES,AX       (* Set ES to BIOS RAM *)
      MOV   AL,$00

      CLI               (* Disable all Interrupts *)
      OUT   $43,AL      (* freez timer 0 *)
      MOV   CX,ES:[$6C] (* CX = LSW of sys timer *)
      STI               (* enable Interrupts *)

      IN    AL,$40      (* Read LSB of timer 0 *)
      MOV   BL,AL
      IN    AL,$40      (* Read MSB of timer 0 *)
      MOV   BH,Al       (* BX = timer 0 *)
                        (* enable Interrupts *)
      NOT   BX          (* timer 0 is a descending counter, we need a
                           ascending counter   *)

      CMP   CX,ES:[$6C] (* if an interrupt had been occured, the systimer
                           is not equal to the number we read bevor   *)
      JE    @NoIntPending   (* no interrupt, no problem *)
      CMP   BX,$FF          (* was the Interrupt pending after frozen the timer *)
      JAE   @NoIntPending   (* bigger or equal -> no *)
      INC   CX              (* we must correct the systimer *)
@NoIntPending:
      MOV   TmpValue.LSW,BX
      MOV   TmpValue.MSW,CX
    End;
     ReadFastTimer := TmpValue.LWord;
End;

{----------------------------------------------------------------------------}

Function  UnGetFastTimerHandle (Handle :Word): Boolean;
{ Original author: Peter Holschbach }

Begin
  UnGetFastTimerHandle := FreeFastHandles [Handle];
  FreeFastHandles [Handle] := False;
End;

{----------------------------------------------------------------------------}

Function  UnGetTimerHandle (Handle :Word): Boolean;
{ Original author: Peter Holschbach }

Begin
  UnGetTimerHandle := FreeHandles [Handle];
  FreeHandles [Handle] := False;
End;

{----------------------------------------------------------------------------}

End.